home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / comprs.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  6KB  |  181 lines
  1. /* comprs.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal cpyknt;
  12.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  13.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  14.         nwd16;
  15. } memmgr_;
  16.  
  17. #define memmgr_1 memmgr_
  18.  
  19. /*<       subroutine comprs(icode,limit) >*/
  20. /* Subroutine */ int comprs_(icode, limit)
  21. integer *icode, *limit;
  22. {
  23.     static integer madr, nblk, mspc, morg, muse, mslp, msiz, ltab1, ltab2, 
  24.         madr2, morg2, muse2;
  25.     extern /* Subroutine */ int copy4_();
  26.     static integer muser, iwsize;
  27.     extern integer nxtevn_();
  28.  
  29. /*<       implicit double precision (a-h,o-z) >*/
  30.  
  31. /*      this routine compresses all available memory into a single block. 
  32. */
  33. /* if *icode* is zero, compression of memory from word 1 to *limit* is */
  34. /* done;  otherwise, compression from *ldval* down to *limit* is done. */
  35.  
  36. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  37. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  38. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  39. /*<      2   nwd8,nwd16 >*/
  40. /*<       if (icode.ne.0) go to 100 >*/
  41.     if (*icode != 0) {
  42.     goto L100;
  43.     }
  44. /*<       nblk=numblk >*/
  45.     nblk = memmgr_1.numblk;
  46. /*<       ltab2=loctab >*/
  47.     ltab2 = memmgr_1.loctab;
  48. /*<    10 ltab1=ltab2 >*/
  49. L10:
  50.     ltab1 = ltab2;
  51. /*<       if (ltab1.ge.limit) go to 200 >*/
  52.     if (ltab1 >= *limit) {
  53.     goto L200;
  54.     }
  55. /*<       if (nblk.eq.1) go to 200 >*/
  56.     if (nblk == 1) {
  57.     goto L200;
  58.     }
  59. /*<       nblk=nblk-1 >*/
  60.     --nblk;
  61. /*<       ltab2=ltab1+ntab >*/
  62.     ltab2 = ltab1 + memmgr_1.ntab;
  63. /*<       morg=istack(ltab1+1) >*/
  64.     morg = memmgr_1.istack[ltab1];
  65. /*<       msiz=istack(ltab1+2) >*/
  66.     msiz = memmgr_1.istack[ltab1 + 1];
  67. /*<       muse=nxtevn(istack(ltab1+3)) >*/
  68.     muse = nxtevn_(&memmgr_1.istack[ltab1 + 2]);
  69. /*<       mslp=istack(ltab1+6) >*/
  70.     mslp = memmgr_1.istack[ltab1 + 5];
  71. /*<       if ((msiz-muse).le.mslp) go to 10 >*/
  72.     if (msiz - muse <= mslp) {
  73.     goto L10;
  74.     }
  75. /*<       muse=muse+mslp >*/
  76.     muse += mslp;
  77. /* ...  move succeeding block down */
  78. /*<       morg2=istack(ltab2+1) >*/
  79.     morg2 = memmgr_1.istack[ltab2];
  80. /*<       muse2=istack(ltab2+3) >*/
  81.     muse2 = memmgr_1.istack[ltab2 + 2];
  82. /*<       madr2=istack(ltab2+4) >*/
  83.     madr2 = memmgr_1.istack[ltab2 + 3];
  84. /*<       iwsize=istack(ltab2+5) >*/
  85.     iwsize = memmgr_1.istack[ltab2 + 4];
  86. /*<       if (madr2.ne.0) go to 15 >*/
  87.     if (madr2 != 0) {
  88.     goto L15;
  89.     }
  90. /*<       if (muse2.eq.0) go to 20 >*/
  91.     if (muse2 == 0) {
  92.     goto L20;
  93.     }
  94. /*<    15 cpyknt=cpyknt+dble(muse2) >*/
  95. L15:
  96.     memmgr_1.cpyknt += (doublereal) muse2;
  97. /*<       call copy4(istack(nwoff+morg2+1),istack(nwoff+morg+muse+1),muse2) >*/
  98.     copy4_(&memmgr_1.istack[memmgr_1.nwoff + morg2], &memmgr_1.istack[
  99.         memmgr_1.nwoff + morg + muse], &muse2);
  100. /*<       istack(lorg+madr2)=(morg+muse)/iwsize >*/
  101.     memmgr_1.istack[memmgr_1.lorg + madr2 - 1] = (morg + muse) / iwsize;
  102. /*<    20 istack(ltab1+2)=muse >*/
  103. L20:
  104.     memmgr_1.istack[ltab1 + 1] = muse;
  105. /*<       istack(ltab2+1)=morg+muse >*/
  106.     memmgr_1.istack[ltab2] = morg + muse;
  107. /*<       istack(ltab2+2)=istack(ltab2+2)+(msiz-muse) >*/
  108.     memmgr_1.istack[ltab2 + 1] += msiz - muse;
  109. /*<       go to 10 >*/
  110.     goto L10;
  111.  
  112.  
  113. /*<   100 nblk=numblk >*/
  114. L100:
  115.     nblk = memmgr_1.numblk;
  116. /*<       ltab2=ldval-ntab >*/
  117.     ltab2 = memmgr_1.ldval - memmgr_1.ntab;
  118. /*<   110 ltab1=ltab2 >*/
  119. L110:
  120.     ltab1 = ltab2;
  121. /*<       if (ltab1.le.limit) go to 200 >*/
  122.     if (ltab1 <= *limit) {
  123.     goto L200;
  124.     }
  125. /*<       if (nblk.eq.1) go to 200 >*/
  126.     if (nblk == 1) {
  127.     goto L200;
  128.     }
  129. /*<       nblk=nblk-1 >*/
  130.     --nblk;
  131. /*<       ltab2=ltab1-ntab >*/
  132.     ltab2 = ltab1 - memmgr_1.ntab;
  133. /*<       morg=istack(ltab1+1) >*/
  134.     morg = memmgr_1.istack[ltab1];
  135. /*<       msiz=istack(ltab1+2) >*/
  136.     msiz = memmgr_1.istack[ltab1 + 1];
  137. /*<       muser=istack(ltab1+3) >*/
  138.     muser = memmgr_1.istack[ltab1 + 2];
  139. /*<       muse=nxtevn(muser) >*/
  140.     muse = nxtevn_(&muser);
  141. /*<       madr=istack(ltab1+4) >*/
  142.     madr = memmgr_1.istack[ltab1 + 3];
  143. /*<       iwsize=istack(ltab1+5) >*/
  144.     iwsize = memmgr_1.istack[ltab1 + 4];
  145. /*<       mslp=istack(ltab1+6) >*/
  146.     mslp = memmgr_1.istack[ltab1 + 5];
  147. /*<       if ((msiz-muse).le.mslp) go to 110 >*/
  148.     if (msiz - muse <= mslp) {
  149.     goto L110;
  150.     }
  151. /*<       muse=muse+mslp >*/
  152.     muse += mslp;
  153. /*<       mspc=msiz-muse >*/
  154.     mspc = msiz - muse;
  155. /*<       cpyknt=cpyknt+dble(muser) >*/
  156.     memmgr_1.cpyknt += (doublereal) muser;
  157. /*<       call copy4(istack(nwoff+morg+1),istack(nwoff+morg+mspc+1),muser) >*/
  158.     copy4_(&memmgr_1.istack[memmgr_1.nwoff + morg], &memmgr_1.istack[
  159.         memmgr_1.nwoff + morg + mspc], &muser);
  160. /*<       istack(ltab1+1)=morg+mspc >*/
  161.     memmgr_1.istack[ltab1] = morg + mspc;
  162. /*<       istack(ltab1+2)=muse >*/
  163.     memmgr_1.istack[ltab1 + 1] = muse;
  164. /*<       istack(ltab2+2)=istack(ltab2+2)+mspc >*/
  165.     memmgr_1.istack[ltab2 + 1] += mspc;
  166. /*<       if (madr.eq.0) go to 110 >*/
  167.     if (madr == 0) {
  168.     goto L110;
  169.     }
  170. /*<       istack(lorg+madr)=(morg+mspc)/iwsize >*/
  171.     memmgr_1.istack[memmgr_1.lorg + madr - 1] = (morg + mspc) / iwsize;
  172. /*<       go to 110 >*/
  173.     goto L110;
  174. /* ...  all done */
  175. /*<   200 return >*/
  176. L200:
  177.     return 0;
  178. /*<       end >*/
  179. } /* comprs_ */
  180.  
  181.